(*
  This file is part of Eduka+.

    Eduka+ is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    Eduka+ is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Eduka+.  If not, see <http://www.gnu.org/licenses/>.
*)

(*

The Original Code is: SynProSyn.pas, released 2005-02-02.
Author of this file is Ciobanu Alexander. All Rights Reserved.

Description :
    Unit generated by an external application. NOT recommended to
    change.

*)

{ Include Compile Directives ! }
{$I Utils\directives.inc}
unit SynProSyn;

{$I '3rdParty\SynEdit\SynEdit.inc'}

interface

uses
  SysUtils,
  Classes,
{$IFDEF SYN_CLX}
  QControls,
  QGraphics,
{$ELSE}
  Windows,
  Controls,
  Graphics,
{$ENDIF}
  ProTypes,
  DesignInside,
  SynEditTypes,
  SynEditHighlighter,
  SynEdit;

type
  TtkTokenKind = (
    tkAnt_Instructions,
    tkKng_Instructions,
    tkComment,
    tkConditions,
    tkIdentifier,
    tkKey,
    tkNull,
    tkSpace,
    tkUnknown);

  TRangeState = (rsUnKnown, rsBraceComment);

  TProcTableProc = procedure of object;

  PIdentFuncTableFunc = ^TIdentFuncTableFunc;
  TIdentFuncTableFunc = function: TtkTokenKind of object;

const
  MaxKey = 10000;

Var
  kBegin,
  kCall,
  kDo,
  kDown,
  kElse,
  kEnd,
  kIf,
  kIsBorder,
  kIsLine,
  kJump,
  kLeft,
  kNot,
  kRepeat,
  kRight,
  kRotate,
  kProcedure,
  kStep,
  kThen,
  kTimes,
  kUntil,
  kUp,
  kWhile : ShortString;

  ikTuxInitConds : Integer;
  kTuxConditions : Array[1..48] of ShortString;

  ikTuxInitKwrd  : Integer;
  kTuxKeyWords   : Array[1..19] of ShortString;
type
  TSynProSyn = class(TSynCustomHighlighter)
  private
    fLine: PChar;
    fLineNumber: Integer;
    fProcTable: array[#0..#255] of TProcTableProc;
    fRange: TRangeState;
    Run: LongInt;
    fStringLen: Integer;
    fToIdent: PChar;
    fTokenPos: Integer;
    fTokenID: TtkTokenKind;
    fIdentFuncTable: array[0 .. MaxKey] of TIdentFuncTableFunc;
    fAnt_InstructionsAttri: TSynHighlighterAttributes;
    fKng_InstructionsAttri: TSynHighlighterAttributes;
    fCommentAttri: TSynHighlighterAttributes;
    fConditionsAttri: TSynHighlighterAttributes;
    fIdentifierAttri: TSynHighlighterAttributes;
    fKeyAttri: TSynHighlighterAttributes;
    fSpaceAttri: TSynHighlighterAttributes;
    function KeyHash(ToHash: PChar): Integer;
    function KeyComp(const aKey: string): Boolean;

    function FuncTTl: TtkTokenKind;
    procedure IdentProc;
    procedure UnknownProc;
    function AltFunc: TtkTokenKind;
    procedure InitIdent;
    function IdentKind(MayBe: PChar): TtkTokenKind;
    procedure MakeMethodTables;
    procedure NullProc;
    procedure SpaceProc;
    procedure CRProc;
    procedure LFProc;
    procedure BraceCommentOpenProc;
    procedure BraceCommentProc;
  protected
    function GetIdentChars: TSynIdentChars; override;
    function GetSampleSource: string; override;
    function IsFilterStored: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    {$IFNDEF SYN_CPPB_1} class {$ENDIF}
    function GetLanguageName: string; override;
    function GetRange: Pointer; override;
    procedure ResetRange; override;
    procedure SetRange(Value: Pointer); override;
    function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
    function GetEol: Boolean; override;
    function GetKeyWords: string;
    function GetTokenID: TtkTokenKind;
    procedure SetLine(NewValue: String; LineNumber: Integer); override;
    function GetToken: String; override;
    function GetTokenAttribute: TSynHighlighterAttributes; override;
    function GetTokenKind: integer; override;
    function GetTokenPos: Integer; override;
    procedure Next; override;
  published
    property Ant_InstructionsAttri: TSynHighlighterAttributes read fAnt_InstructionsAttri write fAnt_InstructionsAttri;
    property Kng_InstructionsAttri: TSynHighlighterAttributes read fKng_InstructionsAttri write fKng_InstructionsAttri;
    property CommentAttri: TSynHighlighterAttributes read fCommentAttri write fCommentAttri;
    property ConditionsAttri: TSynHighlighterAttributes read fConditionsAttri write fConditionsAttri;
    property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri write fIdentifierAttri;
    property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
    property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri write fSpaceAttri;
  end;

procedure ResetHighlighterValues(var Syn : TSynProSyn;var Editor : TSynEdit);

implementation

uses
  SynEditStrConst;

{$IFDEF SYN_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
  SYNS_FilterEduka = 'All files (*.*)|*.*';
  SYNS_LangEduka = 'Eduka+';
  SYNS_AttrAnt_Instructions = 'Ant_Instructions';
  SYNS_AttrKng_Instructions = 'Kng_Instructions';
  SYNS_AttrConditions = 'Conditions';

var
  Identifiers: array[#0..#255] of ByteBool;
  mHashTable : array[#0..#255] of Integer;

procedure MakeIdentTable;
var
  I, J: Char;
begin
  for I := #0 to #255 do
  begin
    if I in IdentCharacters then Identifiers[I] := True else
                                 Identifiers[I] := False;
    J := UpCase(I);
    case I in  [#32..#255] of
      True: mHashTable[I] := Ord(J)
    else
      mHashTable[I] := 0;
    end;
  end;
end;

procedure ResetHighlighterValues(var Syn : TSynProSyn;var Editor : TSynEdit);
begin
  MakeIdentTable;
  Editor.Highlighter := nil;
  if Assigned(Syn) then Syn.Free;
  Syn := TSynProSyn.Create(Editor);
  Editor.Highlighter := Syn;

  Syn.CommentAttri.Foreground:=CommentColor;
  Syn.CommentAttri.Background:=clNone;
  Syn.CommentAttri.Style:=CommentStyle;

  Syn.ConditionsAttri.Foreground:=ConditionColor;
  Syn.ConditionsAttri.Background:=clNone;
  Syn.ConditionsAttri.Style:=ConditionStyle;

  Syn.KeyAttri.Foreground:=KeywordsColor;
  Syn.KeyAttri.Background:=clNone;
  Syn.KeyAttri.Style:=KeywordsStyle;

  Syn.IdentifierAttri.Foreground:=IdentifierColor;
  Syn.IdentifierAttri.Background:=clNone;
  Syn.IdentifierAttri.Style:=IdentifierStyle;
end;

procedure TSynProSyn.InitIdent;
var
  I: Integer;
  pF: PIdentFuncTableFunc;
begin
  pF := PIdentFuncTableFunc(@fIdentFuncTable);
  for I := Low(fIdentFuncTable) to High(fIdentFuncTable) do
  begin
    pF^ := AltFunc;
    Inc(pF);
  end;

  For I:=1 to MaxKey do fIdentFuncTable[I]:=FuncTtl;
end;

function TSynProSyn.KeyHash(ToHash: PChar): Integer;
begin
  Result := 0;
  while ToHash^ in IdentCharacters do
  begin
    inc(Result, mHashTable[ToHash^]);
    inc(ToHash);
  end;
  fStringLen := ToHash - fToIdent;
end;

function TSynProSyn.KeyComp(const aKey: String): Boolean;
var
  I: Integer;
  Temp: PChar;
  aKeyUp : String;
begin
  aKeyUp := AnsiUpperCase(aKey);
  Temp := PChar(AnsiUpperCase(fToIdent));
  if Length(aKey) = fStringLen then
  begin
    Result := True;
    for i := 1 to fStringLen do
    begin
      if mHashTable[Temp^] <> mHashTable[aKeyUp[i]] then
      begin
        Result := False;
        break;
      end;
      inc(Temp);
    end;
  end
  else
    Result := False;
end;


function TSynProSyn.FuncTTl: TtkTokenKind;
var
 i : Integer;
begin
  if KeyComp(kIf)   then Result := tkKey else
  if KeyComp(kDo)   then Result := tkKey else
  if KeyComp(kEnd)  then Result := tkKey else
  if KeyComp(kCall) then Result := tkKey else
  if KeyComp(kBegin)then Result := tkKey else
  if KeyComp(kUp)   then Result := tkAnt_Instructions else
  if KeyComp(kElse) then Result := tkKey else
  if KeyComp(kLeft) then Result := tkAnt_Instructions else
  if KeyComp(kThen) then Result := tkKey else
  if KeyComp(kNot)  then Result := tkKey else
  if KeyComp(kDown) then Result := tkAnt_Instructions else
  if KeyComp(kWhile)then Result := tkKey else
  if KeyComp(kStep) then Result := tkKng_Instructions else
  if KeyComp(kJump) then Result := tkKng_Instructions else
  if KeyComp(kRight)then Result := tkAnt_Instructions else
  if KeyComp(kRepeat) then Result := tkKey else
  if KeyComp(kTimes) then Result := tkKey else
  if KeyComp(kIsLine) then Result := tkConditions else
  if KeyComp(kUntil) then Result := tkKey else
  if KeyComp(kRotate) then Result := tkKng_Instructions else
  if KeyComp(kIsBorder) then Result := tkConditions else
  if KeyComp(kProcedure) then Result := tkKey else Result := tkIdentifier;

 if ikTuxInitConds > 0 then
    for i:=1 to ikTuxInitConds do
        if KeyComp(kTuxConditions[i]) then Result := tkConditions;

 if ikTuxInitKwrd > 0 then
    for i:=1 to ikTuxInitKwrd do
        if KeyComp(kTuxKeyWords[i]) then Result := tkKey;

end;

function TSynProSyn.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TSynProSyn.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey <= MaxKey then
    Result := fIdentFuncTable[HashKey]
  else
    Result := tkIdentifier;
end;

procedure TSynProSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
   begin
    if I in IdentCharacters then fProcTable[I] := IdentProc else
    case I of
      #0: fProcTable[I] := NullProc;
      #10: fProcTable[I] := LFProc;
      #13: fProcTable[I] := CRProc;
      '{': fProcTable[I] := BraceCommentOpenProc;
      #1..#9,
      #11,
      #12,
      #14..#32 : fProcTable[I] := SpaceProc;
    else
      fProcTable[I] := UnknownProc;
    end;
   end;
end;

procedure TSynProSyn.SpaceProc;
begin
  fTokenID := tkSpace;
  repeat
    inc(Run);
  until not (fLine[Run] in [#1..#32]);
end;

procedure TSynProSyn.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TSynProSyn.CRProc;
begin
  fTokenID := tkSpace;
  inc(Run);
  if fLine[Run] = #10 then
    inc(Run);
end;

procedure TSynProSyn.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TSynProSyn.BraceCommentOpenProc;
begin
  Inc(Run);
  fRange := rsBraceComment;
  BraceCommentProc;
  fTokenID := tkComment;
end;

procedure TSynProSyn.BraceCommentProc;
begin
  case fLine[Run] of
     #0: NullProc;
    #10: LFProc;
    #13: CRProc;
  else
    begin
      fTokenID := tkComment;
      repeat
        if (fLine[Run] = '}') then
        begin
          Inc(Run, 1);
          fRange := rsUnKnown;
          Break;
        end;
        if not (fLine[Run] in [#0, #10, #13]) then
          Inc(Run);
      until fLine[Run] in [#0, #10, #13];
    end;
  end;
end;

constructor TSynProSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAnt_InstructionsAttri := TSynHighLighterAttributes.Create(SYNS_AttrAnt_Instructions);
  AddAttribute(fAnt_InstructionsAttri);

  fKng_InstructionsAttri := TSynHighLighterAttributes.Create(SYNS_AttrKng_Instructions);
  AddAttribute(fKng_InstructionsAttri);

  fCommentAttri := TSynHighLighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  fCommentAttri.Foreground := clNavy;
  AddAttribute(fCommentAttri);

  fConditionsAttri := TSynHighLighterAttributes.Create(SYNS_AttrConditions);
  AddAttribute(fConditionsAttri);

  fIdentifierAttri := TSynHighLighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);

  fKeyAttri := TSynHighLighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);

  fSpaceAttri := TSynHighLighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);

  SetAttributesOnChange(DefHighlightChange);
  InitIdent;
  MakeMethodTables;
  fDefaultFilter := SYNS_FilterEduka;
  fRange := rsUnknown;
end;

procedure TSynProSyn.SetLine(NewValue: String; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;

procedure TSynProSyn.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do
    Inc(Run);
end;

procedure TSynProSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
  if FLine[Run] in LeadBytes then
    Inc(Run,2)
  else
{$ENDIF}
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TSynProSyn.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsBraceComment: BraceCommentProc;
  else
    begin
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
    end;
  end;
end;

function TSynProSyn.GetDefaultAttribute(Index: integer): TSynHighLighterAttributes;
begin
  case Index of
    SYN_ATTR_COMMENT    : Result := fCommentAttri;
    SYN_ATTR_IDENTIFIER : Result := fIdentifierAttri;
    SYN_ATTR_KEYWORD    : Result := fKeyAttri;
    SYN_ATTR_WHITESPACE : Result := fSpaceAttri;
  else
    Result := nil;
  end;
end;

function TSynProSyn.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TSynProSyn.GetKeyWords: string;
begin
  Result := '';
end;

function TSynProSyn.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TSynProSyn.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TSynProSyn.GetTokenAttribute: TSynHighLighterAttributes;
begin
  case GetTokenID of
    tkAnt_Instructions: Result := fAnt_InstructionsAttri;
    tkKng_Instructions: Result := fKng_InstructionsAttri;
    tkComment: Result := fCommentAttri;
    tkConditions: Result := fConditionsAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkSpace: Result := fSpaceAttri;
    tkUnknown: Result := fIdentifierAttri;
  else
    Result := nil;
  end;
end;

function TSynProSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TSynProSyn.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

function TSynProSyn.GetIdentChars: TSynIdentChars;
begin
  Result := IdentCharacters;
end;

function TSynProSyn.GetSampleSource: string;
begin
  Result := '';
end;

function TSynProSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterEduka;
end;

{$IFNDEF SYN_CPPB_1} class {$ENDIF}
function TSynProSyn.GetLanguageName: string;
begin
  Result := SYNS_LangEduka;
end;

procedure TSynProSyn.ResetRange;
begin
  fRange := rsUnknown;
end;

procedure TSynProSyn.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

function TSynProSyn.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

initialization
  MakeIdentTable;
{$IFNDEF SYN_CPPB_1}
  RegisterPlaceableHighlighter(TSynProSyn);
{$ENDIF}
end.
